home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / dialogs.tcl < prev    next >
Encoding:
Text File  |  1999-11-16  |  64.9 KB  |  2,229 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "dialogs.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 11/16/1999 {20:40:11 PM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <vince@santafe.edu>
  10.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501
  11.  #     www: <http://www.santafe.edu/~vince/>
  12.  #  
  13.  # Much copyright (c) 1997-1999  Vince Darley, all rights reserved, 
  14.  # rest Pete Keleher, Johan Linde.
  15.  # 
  16.  # Reorganisation carried out by Vince Darley with much help from Tom 
  17.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  18.  # Alpha is shareware; please register with the author using the register 
  19.  # button in the about box.
  20.  #  
  21.  #  Description: 
  22.  # 
  23.  # Much more flexible dialogs for querying the user about flags and
  24.  # vars.  These may be global, mode-dependent, or package-dependent.
  25.  # 
  26.  # Things you may wish to do:
  27.  # 
  28.  #  dialog::pkg_options Pkg
  29.  #  
  30.  # creates a dialog for all array entries 'PkgmodeVars'.  These
  31.  # must have been previously declared using 'newPref'.  These
  32.  # variables are _not_ copied into the global scope; only
  33.  # existing as array entries.
  34.  # 
  35.  # Note that rather than setting up traces on variables, you are
  36.  # often better off using the optional proc argument to newPref;
  37.  # the name of a procedure to call if that element is changed by
  38.  # the user.
  39.  # 
  40.  # The old procedure 'newModeVar' is obsolete.  Use the
  41.  # new procedure 'newPref'.  Why?  It has optional arguments
  42.  # which allow you to declare:
  43.  # 
  44.  #  lists
  45.  #  indexed lists
  46.  #  folders
  47.  #  files
  48.  #  bindings
  49.  #  menu-bindings
  50.  #  applications
  51.  #  variable-list elements
  52.  #  array elements
  53.  #  
  54.  # all of which can be set using the same central mode/global
  55.  # dialogs.
  56.  #  
  57.  # It also lets you add an optional procedure to call when an
  58.  # item changes...  Also if Alpha upgrades to Tcl 8 and namespaces, 
  59.  # it is easy to modify that central procedure to fit everything 
  60.  # with the new scheme.
  61.  # 
  62.  # Most modes will just want to declare their vars using newPref.  
  63.  # There is usually no need to do _anything_ else.
  64.  # 
  65.  # ---
  66.  # 
  67.  # The prefs dialog procs below were based upon Pete Keleher's 
  68.  # originals.
  69.  # ###################################################################
  70.  ##
  71.  
  72. namespace eval dialog {}
  73. namespace eval global {}
  74. namespace eval flag {}
  75.  
  76.  
  77.     
  78. # ◊◊◊◊ Toplevel dialog procedures ◊◊◊◊ #
  79.  
  80. ## 
  81.  # -------------------------------------------------------------------------
  82.  # 
  83.  # "dialog::pkg_options" --
  84.  # 
  85.  #  Make a dialog for the given package, with 'title' for the dialog box.
  86.  #  'not_global' indicates the variables are never copied into the global
  87.  #  scope, remaining in their array ${pkg}modeVars (or '$var' if it is given)
  88.  # 
  89.  # Results:
  90.  #  Nothing
  91.  # 
  92.  # Side effects:
  93.  #  May modify any of the given package's variables.
  94.  # 
  95.  # --Version--Author------------------Changes-------------------------------
  96.  #    1.0     <vince@santafe.edu> original
  97.  # -------------------------------------------------------------------------
  98.  ##
  99. proc dialog::pkg_options {pkg {title ""} {not_global 1} {var ""}} {
  100.     if {!$not_global} {
  101.     # make sure the package variables are global
  102.     global ${pkg}modeVars
  103.     if {[info exists ${pkg}modeVars]} {
  104.         foreach v [array names ${pkg}modeVars] {
  105.         global $v
  106.         set $v [set ${pkg}modeVars($v)]
  107.         }
  108.     }
  109.     }
  110.     if {$title == ""} { 
  111.     set title "Preferences for the '[quote::Prettify $pkg]' package" 
  112.     }
  113.     if {$not_global} {
  114.     global dialog::_not_global_flag
  115.     if {$var == ""} {
  116.         set dialog::_not_global_flag ${pkg}modeVars
  117.     } else {
  118.         set dialog::_not_global_flag $var
  119.     }
  120.     }
  121.     set err [catch {dialog::modifyModeFlags $title $not_global $pkg} result]
  122.     if {$not_global} {
  123.     global dialog::_not_global_flag
  124.     set dialog::_not_global_flag ""
  125.     }
  126.     if {$err} {
  127.     error $result
  128.     }
  129. }
  130. proc dialog::edit_array {var {title ""}} {
  131.     if {$title == ""} {set title "Contents of '$var' array"}
  132.     dialog::pkg_options "" $title 1 $var
  133. }
  134. proc dialog::editOneOfMany {title var store tempStore {what ""}} {
  135.     global modifiedArrayElements modifiedVars $tempStore $store
  136.     if {[regexp {(.*)\(.*\)$} $var "" arr elt]} {
  137.     global $arr
  138.     } else {
  139.     global $var
  140.     }
  141.     set oldInfo [array get $tempStore]
  142.     if {[catch {dialog::pkg_options "" $title 1 $tempStore}] \
  143.       || ($oldInfo == [array get $tempStore])} {
  144.     return
  145.     }
  146.     set oldId [set $var]
  147.     if {![dialog::yesno -y "Update" -n "New $what" \
  148.       "Update [set $var] $what, or make a new one?"]} {
  149.     # Ask for new name
  150.     set name [eval prompt [list "Enter tag for new $what" \
  151.       "<Tag>" "Old ids:"] [array names $store]]
  152.     set ${store}($name) [array get $tempStore]
  153.     set $var $name
  154.     # Have to store Usual id too.
  155.     lappend modifiedArrayElements [list $name $store]
  156.     if {[regexp {(.*)\(.*\)$} $var "" arr elt]} {
  157.         lappend modifiedArrayElements [list $elt $arr]
  158.     } else {
  159.         lappend modifiedVars $var
  160.     }
  161.     } else {
  162.     set ${store}($oldId) [array get $tempStore]
  163.     }
  164.     lappend modifiedArrayElements [list $oldId $store]
  165. }
  166.  
  167. ## 
  168.  # -------------------------------------------------------------------------
  169.  # 
  170.  # "dialog::value_for_variable" --
  171.  # 
  172.  #  Ask for a value, with default given by the given variable, and using
  173.  #  that variable's type (list, file, ...) as a constraint.
  174.  #  
  175.  #  Currently assumes the variable is a list var, but this will change.
  176.  # -------------------------------------------------------------------------
  177.  ##
  178. proc dialog::value_for_variable {var {title ""}} {
  179.     if {$title == ""} { set title [quote::Prettify $var] }
  180.     return [dialog::optionMenu $title [flag::options $var] \
  181.       [uplevel [list set $var]]]
  182. }
  183.  
  184.  
  185. ## 
  186.  # -------------------------------------------------------------------------
  187.  # 
  188.  # "dialog::paged" --
  189.  # 
  190.  #  Under development.  Not yet usable!
  191.  # -------------------------------------------------------------------------
  192.  ##
  193. proc dialog::paged {args} {
  194.     getOpts {-pageproc}
  195.     set pages [lindex $args 0]
  196.     lappend dialog -m [concat [lindex $pages 0] $pages] 100 10 200 40
  197.     set xmax -1
  198.     set ymax -1
  199.     set i 1
  200.     foreach page $pages {
  201.     lappend dialog -n $page
  202.     set contents [$opts(-pageproc) $page 20 50]
  203.     set x [lindex $contents 0]
  204.     set y [lindex $contents 1]
  205.     set contents [lindex $contents 2]
  206.     if {$x > $xmax} { set xmax $x }
  207.     if {$y > $ymax} { set ymax $x }
  208.     incr i
  209.     }
  210.     incr ymax 15
  211.     incr xmax 20
  212.     eval dialog -w $xmax -h [expr {$ymax+40}] [dialog::okcancel 10 ymax] $dialog
  213. }
  214.  
  215. proc helperApps {} {
  216.     set sigs [info globals *Sig]
  217.     regsub -all {Sig} $sigs {} sigs
  218.     set sig [listpick -p "Change/inspect which helper?" [lsort $sigs]]
  219.     set sig ${sig}Sig
  220.     global $sig
  221.     if {![info exists $sig]} { set $sig "" }
  222.     set nsig [dialog::askFindApp $sig [set $sig]]
  223.     if {$nsig != "" && [set $sig] != $nsig} {
  224.     set $sig $nsig
  225.     global modifiedVars
  226.     lappend modifiedVars $sig
  227.     }
  228. }
  229.  
  230. proc suffixMappings {} {
  231.     global filepats
  232.     
  233.     set l1 5
  234.     set w1 38
  235.     set l2 [expr {$l1 + $w1 + 5}]
  236.     set w2 200
  237.     set h 18
  238.     set top 5
  239.     set mar 5
  240.     
  241.     set modes [lsort -ignore [array names filepats]]
  242.     set len [expr {[llength $modes] + 1}]
  243.     set modes1 [lrange $modes 0 [expr {$len/2 - 1}]]
  244.     set modes2 [lrange $modes [expr {$len/2}] end]
  245.     
  246.     foreach m $modes1 {
  247.     lappend items -t $m $l1 $top [expr {$l1 + $w1}] [expr {$top + $h}]
  248.     lappend items -e $filepats($m) $l2 $top [expr {$l2 + $w2}] \
  249.       [expr {$top + $h - 2}]
  250.     incr top [expr {$h + $mar}]
  251.     }
  252.     
  253.     set top2 5
  254.     set l1 [expr {$l2 + $w2 + 20}]
  255.     set l2 [expr {$l1 + $w1 + 5}]
  256.     foreach m $modes2 {
  257.     lappend items -t $m $l1 $top2 [expr {$l1 + $w1}] [expr {$top2 + $h}]
  258.     lappend items -e $filepats($m) $l2 $top2 [expr {$l2 + $w2}] \
  259.       [expr {$top2 + $h - 2}]
  260.     incr top2 [expr {$h + $mar}]
  261.     }
  262.     
  263.     if {$top2 > $top} {
  264.     set top $top2
  265.     }
  266.     incr top $mar
  267.     
  268.     set l1 5
  269.     lappend buts -b OK $l1 $top [expr {$l1 + 60}] [expr {$top + 20}]
  270.     lappend buts -b Cancel [expr {$l1 + 100}] $top [expr {$l1 + 160}] \
  271.       [expr {$top + 20}]
  272.     
  273.     set res [eval "dialog -w [expr {$l2 + $w2 + 10}] -h [expr {$top + 27}]" \
  274.       $buts $items]
  275.     
  276.     if {[lindex $res 0]} {
  277.     set res [lrange $res 2 end]
  278.     
  279.     set changed ""
  280.     foreach m [lsort -ignore [array names filepats]] {
  281.         if {$filepats($m) != [lindex $res 0]} {
  282.         lappend changed [list $m [lindex $res 0]]
  283.         }
  284.         set res [lrange $res 1 end]
  285.     }
  286.     
  287.     foreach pair $changed {
  288.         eval addArrDef filepats [lrange $pair 0 1]
  289.         set filepats([lindex $pair 0]) [lindex $pair 1]
  290.     }
  291.     }
  292.     mode::updateSuffixes
  293. }
  294. proc dialog::mode {flags vars {title ""}} {
  295.     set lim [expr {10 - [llength $flags]/4}]
  296.     if {[llength $vars] > $lim } {
  297.     set args {}
  298.     set nvars [llength $vars]
  299.     set j 0
  300.     for {set i 0} {$i < $nvars} {incr i $lim ; set lim 10} {
  301.         lappend args [list "Page [incr j] of ${title}" $flags \
  302.           [lrange $vars $i [expr {$i+$lim -1}]]]
  303.         set flags ""
  304.     }
  305.     dialog::multipage $args
  306.     } else {
  307.     dialog::onepage $flags $vars $title
  308.     }
  309. }
  310. ## 
  311.  # -------------------------------------------------------------------------
  312.  # 
  313.  # "dialog::modifyModeFlags" --
  314.  # 
  315.  #  Currently 'not_global == 0' implies this is a mode, or at least that
  316.  #  the variables are stored in ${mm}modeVars(...)
  317.  #  
  318.  #  'not_global == 1' implies that the variables are stored in the
  319.  #  array given by the value of the variable 'dialog::_not_global_flag'
  320.  #  
  321.  #  Recently removed a call to mode::updateSuffixes which is not necessary
  322.  # -------------------------------------------------------------------------
  323.  ##
  324. proc dialog::modifyModeFlags {{title ""} {not_global 0} {mm ""}} {
  325.     global mode invisibleModeVars modifiedArrayElements \
  326.       dialog::_not_global_flag allFlags flag::procs
  327.     # Check whether this is a mode or package, and where variable values
  328.     # are stored, and whether that's at the global level as well as in
  329.     # an array...
  330.     if {$not_global} {
  331.     set storage ${dialog::_not_global_flag}
  332.     if {$title == ""} {
  333.         set title "Preferences for '${mm}' package"
  334.     }
  335.     } else {
  336.     if {$mm == ""} { 
  337.         set mm $mode 
  338.         if {$mm == ""} {
  339.         alertnote "No mode set!"
  340.         return
  341.         }
  342.     }
  343.     set storage ${mm}modeVars
  344.     if {$title == ""} {
  345.         set title "Preferences for '${mm}' mode"
  346.     }
  347.     }
  348.     # check for mode specific proc
  349.     if {[info commands ${mm}modifyFlags] != ""} {${mm}modifyFlags; return}
  350.     if {[info tclversion] >= 8.0} { set storage ::$storage }
  351.     set flags {}
  352.     set vars {}
  353.     global $storage ${storage}Invisible
  354.     if {[info exists $storage]} {
  355.     set unsortedNames [array names $storage]
  356.     set colors {}
  357.     set rest {}
  358.     foreach i $unsortedNames {
  359.         if {[regexp {Colou?r$} $i]} {
  360.         lappend colors $i
  361.         } else {
  362.         lappend rest $i
  363.         }
  364.     }
  365.     
  366.     foreach v [concat [lsort $rest] [lsort $colors]] {
  367.         if {[info exists invisibleModeVars($v)] \
  368.           || [info exists ${storage}Invisible($v)]} continue
  369.         
  370.         if {[lsearch -exact $allFlags $v] >= 0} {
  371.         lappend flags $v
  372.         } else {
  373.         lappend vars $v
  374.         }
  375.     }
  376.     
  377.     if {[catch {dialog::mode $flags $vars $title} values_items]} {
  378.         return
  379.     }
  380.     set res [lindex $values_items 0]
  381.     set editItems [lindex $values_items 1]
  382.     unset values_items
  383.     
  384.     foreach fset $editItems {
  385.         if {[llength $fset] > 1} {
  386.         set fset [lrange $fset 1 end]
  387.         }
  388.         foreach flag $fset {
  389.         set val [lindex $res 0]
  390.         set res [lrange $res 1 end]
  391.         dialog::postManipulate
  392.         if {$not_global} {
  393.             # it's a package which keeps its vars in the array
  394.             if {[set ${storage}($flag)] != $val} {
  395.             set ${storage}($flag) $val
  396.             lappend modifiedArrayElements [list $flag $storage]
  397.             if {[info exists flag::procs($flag)]} {
  398.                 eval [set flag::procs($flag)] [list $flag]
  399.             }
  400.             }
  401.         } else {
  402.             # modes keep a copy of their vars at the global 
  403.             # level when active
  404.             global $flag
  405.             if {[set $flag] != $val} {
  406.             set $flag $val
  407.             set ${storage}($flag) $val
  408.             lappend modifiedArrayElements [list $flag $storage]
  409.             
  410.             if {[info exists flag::procs($flag)]} {
  411.                 eval [set flag::procs($flag)] [list $flag]
  412.             }
  413.             }
  414.         }
  415.         }
  416.     }
  417.     } else {
  418.     alertnote "The '$mm' mode/package has no preference settings."
  419.     }
  420.     
  421.     hook::callAll dialog::modifyModeFlags $mm $title
  422.     
  423. }
  424.  
  425. ## 
  426.  # -------------------------------------------------------------------------
  427.  # 
  428.  # "dialog::getAKey" --
  429.  # 
  430.  #  Returns a keystring to be used for binding a key in a menu, 
  431.  #  using a nice dialog box to ask the user.
  432.  # 
  433.  #  Possible improvements: we could replace the dialog
  434.  #  box with a status-line prompt (which would allow the use of
  435.  #  getModifiers to check what keys the user pressed).
  436.  #  
  437.  #  Now handles 'prefixChar' bindings for non-menu items.
  438.  #  i.e. you can use this dialog to bind something to 'ctrl-x ctrl-s',
  439.  #  for instance.
  440.  # 
  441.  #  If the name contains '/' it is considered to be two items,
  442.  #  separated by that '/', which are to take the same binding,
  443.  #  except that one of them will use the option key.
  444.  #  
  445.  #  Similarly '//' means use shift, '///' means shift-option,
  446.  #  For instance 'dialog::getAKey close/closeAll//closeFloat /W<O'
  447.  #  would give you the menu-item for 'close' in the file menu. 
  448.  #  except these last two aren't implemented yet ;-)
  449.  # --Version--Author------------------Changes-------------------------------
  450.  #    1.0     Johan Linde         original
  451.  #    1.1     <vince@santafe.edu> can do non-menu bindings too
  452.  #    1.2     <vince@santafe.edu> handles arrow keys
  453.  #    1.2.1   Johan Linde        handles key pad keys
  454.  # -------------------------------------------------------------------------
  455.  ##
  456. proc dialog::getAKey {{name {}} {keystr {}} {for_menu 1}} {
  457.     global keys::func
  458.     # two lists for any other keys which look better with a text description
  459.     set otherKeys {"<No binding>" "-" Space}
  460.     set otherKeyChars [list "" "" " "]
  461.     if {!$for_menu} {
  462.     lappend otherKeys Left Right Up Down "Key pad =" \
  463.       "Key pad /" "Key pad *" "Key pad -" "Key pad +" "Key pad ."
  464.     lappend otherKeyChars "" "" "\x10" "" Kpad= \
  465.       Kpad/ Kpad* Kpad- Kpad+ Kpad.
  466.     for {set i 0} {$i < 10} {incr i} {
  467.         lappend otherKeys "Key pad $i"
  468.         lappend otherKeyChars Kpad$i
  469.     }
  470.     }
  471.     set nname $name
  472.     set shift-opt [expr {![regsub {///} $nname { so-} $nname]}]
  473.     set shift  [expr {![regsub {//} $nname { s-} $nname]}]
  474.     set option [expr {![regsub {/} $nname { o-} $nname]}]
  475.     if {[string length $keystr]} {
  476.     set values "0 0"
  477.     set mkey [keys::verboseKey $keystr normal]
  478.     if {$normal} {
  479.         lappend values "Normal Key"
  480.     } else {
  481.         lappend values $mkey
  482.         set mkey {}
  483.     }
  484.     lappend values [regexp {<U} $keystr]
  485.     lappend values [regexp {<B} $keystr]
  486.     if {!$for_menu} {
  487.         if {[regexp "«(.*)»" $keystr "" i]} {
  488.         if {$i == "e"} {
  489.             lappend values "escape"
  490.         } else {
  491.             lappend values "ctrl-$i"
  492.         }
  493.         } else {
  494.         lappend values "<none>"
  495.         }
  496.     }
  497.     if {$option} {lappend values [regexp {<I} $keystr]}
  498.     lappend values [regexp {<O} $keystr]
  499.     lappend values $mkey
  500.     } else {
  501.     set values {0 0 "" 0 0}
  502.     if {!$for_menu} { lappend values <none> }
  503.     if {$option} {lappend values 0}
  504.     lappend values 0 ""
  505.     }
  506.     if {$for_menu} {
  507.     set title "Menu key binding"
  508.     } else {
  509.     set title "Key binding"
  510.     set prefixes [keys::findPrefixChars]
  511.     foreach i $prefixes {
  512.         lappend prefix "ctrl-$i"
  513.     }
  514.     lappend prefixes e
  515.     lappend prefix "escape"
  516.     }
  517.     if {$name != ""} { append title " for '$name'" }
  518.     set usep [info exists prefix]
  519.     global alpha::modifier_keys
  520.     while {1} {
  521.     # Build box
  522.     set box "-t [list $title] 10 10 315 25  -t Key 10 40 40 55 \
  523.       -m [list [concat [list [lindex $values 2]] \
  524.       [list "Normal key"] $otherKeys ${keys::func}]] 80 40 180 57 \
  525.       -c Shift [list [lindex $values 3]] 10 70 60 85 \
  526.       -c Control [list [lindex $values 4]] 80 70 150 85"
  527.     if {$usep} {
  528.         lappend box -t Prefix 190 40 230 55  \
  529.           -m [concat [list [lindex $values 5]]  "<none>" "-" $prefix] \
  530.           235 40 315 57
  531.     }
  532.     if {$option} {
  533.         lappend box -c [lindex ${alpha::modifier_keys} 2] \
  534.           [lindex $values [expr {5 + $usep}]] 160 70 220 85
  535.     }
  536.     lappend box -c [lindex ${alpha::modifier_keys} 0] \
  537.       [lindex $values [expr {5 + $option +$usep}]] 230 70 315 85
  538.     lappend box -n "Normal key" -e [lindex $values [expr {6 + $option +$usep}]] 50 40 70 55
  539.     set values [eval [concat dialog -w 330 -h 130 -b OK 20 100 85 120 -b Cancel 105 100 170 120 $box]]
  540.     # Interpret result
  541.     if {[lindex $values 1]} {error "Cancel"}
  542.     # work around a little Tcl problem
  543.     regsub "\{\{\}" $values "\\\{" values
  544.     set elemKey [string toupper [string trim [lindex $values [expr {6 + $option +$usep}]]]]
  545.     set special [lindex $values 2]
  546.     set keyStr ""
  547.     if {[lindex $values 3]} {append keyStr "<U"}
  548.     if {[lindex $values 4]} {append keyStr "<B"}
  549.     if {$option && [lindex $values [expr {5 + $usep}]]} {append keyStr "<I"}
  550.     if {[lindex $values [expr {5 + $option +$usep}]]} {append keyStr "<O"}
  551.     if {$usep} {
  552.         set pref [lindex $values 5]
  553.         if {$pref != "<none>"} {
  554.         set i [lsearch -exact $prefix $pref]
  555.         append keyStr "«[lindex $prefixes $i]»"
  556.         }
  557.     }
  558.     if {[string length $elemKey] > 1 && $special == "Normal key"} {
  559.         alertnote "You should only give one character for key binding."
  560.     } else {
  561.         if {$for_menu} {
  562.         if {$special == "Normal key" && [text::Ascii $elemKey] > 126} {
  563.             alertnote "Sorry, can't define a key binding with $elemKey."
  564.         } elseif {$elemKey != "" && $special == "Normal key" && ($keyStr == "" || $keyStr == "<U")} {
  565.             alertnote "You must choose at least one of the modifiers control, option and command."
  566.         } elseif {![regexp {F[0-9]} $special] && $special != "Tab" && $special != "Normal key" && $special != "<No binding>" && $keyStr == ""} {
  567.             alertnote "You must choose at least one modifier."
  568.         } else {
  569.             break
  570.         }
  571.         } else {
  572.         break
  573.         }
  574.     }
  575.     }
  576.     if {$special == "<No binding>"} {set elemKey ""}
  577.     if {$special != "Normal key" && $special != "<No binding>"} {
  578.     if {[set i [lsearch -exact $otherKeys $special]] != -1} {
  579.         set elemKey [lindex $otherKeyChars $i]
  580.     } else {
  581.         set elemKey [text::Ascii [expr {[lsearch -exact ${keys::func} $special] + 97}] 1]
  582.     }
  583.     }
  584.     if {![string length $elemKey]} {
  585.     set keyStr ""
  586.     } else {
  587.     append keyStr "/$elemKey"
  588.     }    
  589.     return $keyStr
  590. }
  591.  
  592. ## 
  593.  # -------------------------------------------------------------------------
  594.  # 
  595.  # "dialog::optionMenu" --
  596.  # 
  597.  #  names is the list of items.  An item '-' is a divider, and empty items
  598.  #  are not allowed.
  599.  # -------------------------------------------------------------------------
  600.  ##
  601. proc dialog::optionMenu {prompt names {default ""} {index 0}} {
  602.     if {$default == ""} {set default [lindex $names 0]}
  603.     
  604.     set y 5
  605.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  606.     if {[string length $prompt] > 60} { set w 500 }
  607.     
  608.     # in case we need a wide pop-up area that needs more room
  609.     set popUpWidth [eval dialog::_reqWidth $names]
  610.     set altWidth [expr {$popUpWidth + 60}]
  611.     set w [expr {$altWidth > $w ? $altWidth : $w}]
  612.     
  613.     set dialog [dialog::text $prompt 5 y [expr {int($w/6.7)}]]
  614.     incr y 10
  615.     eval lappend dialog [dialog::menu 30 y $names $default $popUpWidth]
  616.     incr y 20
  617.     eval lappend dialog [dialog::okcancel [expr {$w - 160}] y 0]
  618.     set res [eval dialog -w $w -h $y $dialog]
  619.     
  620.     if {[lindex $res 2]} { error "Cancel" } 
  621.     # cancel was pressed
  622.     if {$index} {
  623.     # we have to take out the entries correponding to pop-up 
  624.     # menu separator lines -trf
  625.     set possibilities [lremove -all $names "-"]
  626.     return [lsearch -exact $possibilities [lindex $res 0]]
  627.     } else {
  628.     return [lindex $res 0]
  629.     }
  630. }
  631.  
  632. ## 
  633.  # -------------------------------------------------------------------------
  634.  # 
  635.  # "dialog::alert" --
  636.  # 
  637.  #  Identical to 'alertnote' but copes with larger blocks of text, and
  638.  #  resizes to that text as appropriate.
  639.  # -------------------------------------------------------------------------
  640.  ##
  641. proc dialog::alert {args} {
  642.     eval [list dialog::yesno -y "Ok" -n ""] $args
  643. }
  644.  
  645. proc dialog::errorAlert {args} {
  646.     eval dialog::alert $args
  647.     error [lindex $args 0]
  648. }
  649.  
  650. ## 
  651.  # -------------------------------------------------------------------------
  652.  # 
  653.  # "dialog::yesno" --
  654.  # 
  655.  #  Make a dialog with between 1 and 3 buttons, representing '1', '0' and
  656.  #  error "Cancel" respectively.  The names of the first two can be given
  657.  #  with '-y name' and '-n name' respectively.  The cancel button is
  658.  #  only used if a '-c' flag is given (and its name is fixed).
  659.  #  
  660.  #  The procedure automatically sizes the dialog and buttons to fit the
  661.  #  enclosed text.
  662.  # -------------------------------------------------------------------------
  663.  ##
  664. proc dialog::yesno {args} {
  665.     # too long for Alpha's standard dialog
  666.     getOpts {-y -n}
  667.     set prompt [lindex $args 0]
  668.     set y 5
  669.     set w [expr {[string length $prompt] > 20 ? 350 : 200}]
  670.     if {[string length $prompt] > 60} { set w 500 }
  671.     
  672.     set dialog [dialog::text $prompt 5 y [expr {int($w/6.7)}]]
  673.     incr y 10
  674.     set x 10
  675.     if {[info exists opts(-y)] && $opts(-y) != ""} {
  676.     lappend buttons $opts(-y) "" y
  677.     } else {
  678.     lappend buttons "Yes" "" y
  679.     }
  680.     if {[info exists opts(-n)]} {
  681.     if {$opts(-n) != ""} {
  682.         lappend buttons $opts(-n) "" y
  683.     }
  684.     } else {
  685.     lappend buttons "No" "" y
  686.     }
  687.     if {[info exists opts(-c)]} {
  688.     lappend buttons "Cancel" "" y
  689.     }
  690.     eval lappend dialog [eval dialog::button $buttons]
  691.     if {$x > $w} { set w [expr {$x + 15}] }
  692.     set res [eval dialog -w $w -h $y $dialog]
  693.     if {[lindex $res 0]} {
  694.     return 1
  695.     } elseif {[lindex $res 1]} {
  696.     return 0
  697.     } else {
  698.     error "cancelled"
  699.     }
  700. }
  701.  
  702. proc dialog::password {{msg "Please enter password:"}} {
  703.     set values [dialog -w 300 -h 90 -t $msg 10 20 290 35 \
  704.       -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  705.     if {[lindex $values 2]} {error "Cancel"}
  706.     return [lindex $values 0]
  707. }
  708.  
  709. proc global::allPrefs {{which "AllPreferences"}} {
  710.     dialog::resetModified
  711.     global flagPrefs varPrefs
  712.     global::updateHelperFlags
  713.     global::updatePackageFlags
  714.     set AllPreferences [array names flagPrefs]
  715.     set InterfacePreferences {Appearance Electrics Text Tiling Window}
  716.     set Input-OutputPreferences {Backups Files Printer Tags WWW}
  717.     set SystemPreferences [lremove -l $AllPreferences \
  718.       $InterfacePreferences ${Input-OutputPreferences} Packages]
  719.     foreach nm [set [join ${which} ""]] {
  720.     lappend args [list $nm $flagPrefs($nm) $varPrefs($nm)]
  721.     }
  722.     dialog::is_global {
  723.     dialog::global_adjust_flags [dialog::multipage $args]
  724.     }
  725. }
  726.  
  727. proc dialog::preferences {menu nm} {
  728.     global flagPrefs varPrefs
  729.     if {[string match "Suffix Mappings" $nm]} {
  730.     return [suffixMappings]
  731.     } elseif {[string match "Menus And Features" $nm]} {
  732.     return [global::menusAndFeatures]
  733.     } elseif {[string match "Save Preferences Now" $nm]} {
  734.     return [prefs::saveNow]
  735.     } elseif {[string match "Edit Prefs File" $nm]} {
  736.     return [prefs::tclEdit]
  737.     }
  738.     if {![info exists flagPrefs($nm)]} { 
  739.     set nm "[string toupper [string index $nm 0]][string range $nm 1 end]" 
  740.     }
  741.     if {[string match "*Preferences" $nm]} { return [global::allPrefs $nm] }
  742.     if {$nm == "Packages"} { global::updatePackageFlags }
  743.     if {$nm == "Helper Applications"} { global::updateHelperFlags }
  744.     dialog::is_global {
  745.     dialog::global_adjust_flags [dialog::onepage $flagPrefs($nm) $varPrefs($nm) "$nm preferences…"]
  746.     }
  747. }
  748.  
  749. # ◊◊◊◊ Finding applications ◊◊◊◊ #
  750.  
  751.  
  752. proc dialog::askFindApp {var sig} {
  753.     if {$sig == ""} {
  754.     set text "Currently unassigned.   Set?"
  755.     } elseif {[catch {nameFromAppl '$sig'} name]} {
  756.     set text "App w/ sig '$sig' doesn't seem to exist.   Change?"
  757.     } else {
  758.     set text "Current value is '$name'.   Change?"
  759.     }
  760.     if {[dialog::yesno $text]} {
  761.     set nsig [dialog::findApp $var $sig]
  762.     set app [nameFromAppl $nsig]
  763.     if {[dialog::yesno "Are you sure you want to set $var to '$nsig'\
  764.       (mapped to '$app')?"]} {
  765.         return $nsig
  766.     }
  767.     }
  768.     return ""
  769. }
  770.  
  771. proc dialog::findApp {var sig} {
  772.     global ${var}s modifiedVars
  773.     if {[info exists ${var}s]} {
  774.     # have a list of items
  775.     set sigs [set ${var}s]
  776.     
  777.     set s 0
  778.     foreach f $sigs {
  779.         if {![catch {nameFromAppl $f} path]} {
  780.         lappend items [file tail $path]
  781.         lappend itemsigs $f
  782.         incr s
  783.         }
  784.     }
  785.     if {$s} {
  786.         lappend items "-" "Locate manually…"
  787.         if {[catch {dialog::optionMenu "Select a new helper for '$var':" \
  788.           $items "" 1} p]} {
  789.         return ""
  790.         }
  791.         # we removed a bunch of items above, so have to look here
  792.         if {$p < $s} {
  793.         return [lindex $itemsigs $p]
  794.         }
  795.     }
  796.     if {!$s || $p >= $s} {
  797.         set nsig [dialog::_findApp $var $sig]
  798.         if {$nsig != ""} {
  799.         if {[lsearch $sigs $nsig] == -1} {
  800.             lappend ${var}s $nsig
  801.             lappend modifiedVars ${var}s
  802.         }
  803.         }
  804.     } else {
  805.         set nsig [lindex $sigs $p]
  806.     }
  807.     return $nsig
  808.     } else {
  809.     return [dialog::_findApp $var $sig]
  810.     }
  811. }
  812.  
  813. proc dialog::_findApp {var sig} {
  814.     if {[catch {getfile "Locate new helper for '$var':"} path]} { return "" }
  815.     set nsig [getFileSig $path]
  816.     set app [nameFromAppl $nsig]
  817.     if {$app != $path} {
  818.     alertnote "Appl sig '$nsig' is mapped to '$app', not '$path'. Remove the former, or rebuild your desktop."
  819.     return ""
  820.     }
  821.     return $nsig
  822. }
  823.  
  824. # ◊◊◊◊ Global/mode menus ◊◊◊◊ #
  825.  
  826. ## 
  827.  # -------------------------------------------------------------------------
  828.  # 
  829.  # "dialog::pickMenusAndFeatures" --
  830.  # 
  831.  #  Prompt the user to select menus and features either globally or
  832.  #  for a given mode.  We need to make sure that those items in
  833.  #  the mode-list which are also in the global list aren't forgotten
  834.  #  (since they are removed from the dialog).
  835.  # -------------------------------------------------------------------------
  836.  ##
  837. proc dialog::pickMenusAndFeatures {mode} {
  838.     global mode::features global::features alpha::packagesAlwaysOn
  839.     set all [package::partition $mode]
  840.     set menus1 [lindex $all 0]
  841.     set menus2 [lindex $all 1]
  842.     set menus3 [lindex $all 2]
  843.     set features1 [lindex $all 3]
  844.     set features2 [lindex $all 4]
  845.     set features3 [lindex $all 5]
  846.     set all [eval concat $all]
  847.     set displayed {}
  848.     # decide on two or three column
  849.     #set endw [expr [llength $all] > 50 ? 560 : 380]
  850.     set endw 560
  851.     set chosen ""
  852.     set notchosen ""
  853.     if {$mode == "global"} {
  854.     set current ${global::features}
  855.     set prefix "Select global #"
  856.     lappend names0 {Select global menus}
  857.     set types [list Usual "" "Other possible"]
  858.     } else {
  859.     foreach pkg [set current [set mode::features($mode)]] {
  860.         if {[lsearch -exact ${global::features} $pkg] != -1} {
  861.         lappend chosen $pkg
  862.         } else {
  863.         if {[string index $pkg 0] == "-"} {
  864.             set pkg [string range $pkg 1 end]
  865.             if {[lsearch -exact ${global::features} $pkg] != -1} {
  866.             # these are the ones which are disabled
  867.             lappend notchosen $pkg
  868.             }
  869.         }
  870.         }
  871.     }
  872.     set prefix "Select # for mode '$mode'"
  873.     lappend names0 "Select menus for mode '$mode'" 
  874.     set types [list Usual General "Other possible"]
  875.     }
  876.     set tmpcurrent $current
  877.     while 1 {
  878.     set maxh 0
  879.     set box ""
  880.     set names $names0
  881.     foreach type {menus features off} {
  882.         if {$mode == "global" && $type == "off"} {break}
  883.         set w 20
  884.         set h 45
  885.         set i 0
  886.         if {$type == "off"} {
  887.         set subm "Turn items off"
  888.         set types [list "Usually on for this mode" "Uncheck to disable"]
  889.         set off1 [lsort $chosen]
  890.         set off2 [lsort [lremove -l ${global::features} $chosen]]
  891.         set alloff [concat $off1 $off2]
  892.         } else {
  893.         regsub "\#" $prefix $type subm
  894.         }
  895.         set page 1
  896.         lappend names $subm
  897.         lappend box "-n" $subm
  898.         if {$type == "off"} {
  899.         lappend box -t "These items are currently globally on. You can turn them off just for this mode here."  10 $h [expr {$endw -20}] [expr {$h +15}]
  900.         incr h 20
  901.         }
  902.         foreach block $types {
  903.         incr i
  904.         if {[llength [set ${type}$i]] == 0} {
  905.             continue
  906.         }
  907.         if {$type == "off"} {
  908.             lappend box -t "$block:"
  909.         } else {
  910.             lappend box -t "$block $type:" 
  911.         }
  912.         lappend box 10 $h [expr {$w +160}] [expr {$h +15}]
  913.         incr h 20
  914.         foreach m [set ${type}$i] {
  915.             if {[lsearch -exact [set alpha::packagesAlwaysOn] $m] != -1} {
  916.             continue
  917.             }
  918.             lappend displayed $m
  919.             if {$h > 360} {
  920.             if {$h > $maxh} {set maxh $h}
  921.             incr page
  922.             lappend names "$subm page $page"
  923.             lappend box "-n" "$subm page $page"
  924.             set h 45
  925.             lappend box -t "$block $type continued..." 10 $h \
  926.               [expr {$w +260}] [expr {$h +15}]
  927.             incr h 20
  928.             }
  929.             set name [quote::Prettify $m]
  930.             if {$type == "off"} {
  931.             set tick [expr {([lsearch -exact $notchosen $m] < 0)}]
  932.             } else {
  933.             set tick [expr {([lsearch -exact $tmpcurrent $m] >= 0)}]
  934.             }
  935.             lappend box -c $name $tick $w $h  [expr {$w + 160}] [expr {$h + 15}]
  936.             incr w 180
  937.             if {$w == $endw} {set w 20; incr h 20}
  938.         }
  939.         if {$w != 20} {
  940.             incr h 30 ; set w 20
  941.         }
  942.         }
  943.         if {$h > $maxh} {set maxh $h}
  944.         
  945.     }
  946.     set h $maxh
  947.     incr h 20
  948.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  949.       -b OK 20 $h 85 [expr {$h + 20}] \
  950.       -b Cancel 105 $h 170 [expr {$h + 20}]  \
  951.       -b Help [expr {$endw -200}] $h [expr {$endw - 140}] [expr {$h + 20}] \
  952.       -b Descriptions [expr {$endw -120}] $h [expr {$endw -20}] [expr {$h + 20}] \
  953.       -m [list $names] [expr {($endw - 220)/2}] 10 $endw 30 $box]]
  954.     
  955.     set names0 [list [lindex $values 4]]
  956.     if {[lindex $values 0]} {break}
  957.     if {[lindex $values 1]} {return $current}
  958.     if {[lindex $values 2]} {
  959.         dialog::describeMenusAndFeatures Help
  960.     }
  961.     if {[lindex $values 3]} {
  962.         dialog::describeMenusAndFeatures Describe
  963.     }    
  964.     set tmpcurrent ""
  965.     for {set i 0} {$i < [llength $displayed]} {incr i} {
  966.         if {[lindex $values [expr {$i + 5}]]} {
  967.         lappend tmpcurrent [lindex $displayed $i]
  968.         }
  969.     }
  970.     }
  971.  
  972.     for {set i 0} {$i < [llength $displayed]} {incr i} {
  973.     if {[lindex $values [expr {$i + 5}]]} {lappend chosen [lindex $displayed $i]}
  974.     }
  975.     if {$mode != "global"} {
  976.     for {set j 0} {$j < [llength [set global::features]]} {incr i ; incr j} {
  977.         if {![lindex $values [expr {$i + 5}]]} {
  978.         # turned one off
  979.         set itm [lindex $alloff $j]
  980.         if {[set idx [lsearch -exact $chosen $itm]] != -1} {
  981.             set chosen [lreplace $chosen $idx $idx "-$itm"]
  982.         } else {
  983.             lappend chosen "-$itm"
  984.         }
  985.         } 
  986.     }
  987.     }
  988.     return $chosen
  989. }
  990.  
  991. proc dialog::describeMenusAndFeatures {{what "Help"}} {
  992.     set all [package::partition]
  993.     set okmenu [lindex $all 0]
  994.     set okfeature [lindex $all 1]
  995.     set okmode [lindex $all 2]
  996.     set all [eval concat $all]
  997.     # decide on two or three column
  998.     set endw [expr {[llength $all] > 50 ? 560 : 380}]
  999.     if {$what == "Help"} {
  1000.     set prefix "Read help for a #"
  1001.     } else {
  1002.     set prefix "Describe a #"
  1003.     }
  1004.     foreach m {menu feature mode} {
  1005.     regsub "\#" $prefix $m subm
  1006.     lappend names $subm
  1007.     }
  1008.     lappend box -m [concat [list [lindex $names 0]] $names] \
  1009.       [expr {($endw - 150)/2}] 10 $endw 30
  1010.     set maxh 0
  1011.     set wincr 160
  1012.     foreach type {menu feature mode} {
  1013.     set w 20
  1014.     set h 45
  1015.     regsub "\#" $prefix $type subm
  1016.     lappend box "-n" $subm
  1017.     if {$type == "mode"} {set wincr 70}
  1018.     foreach m [set ok$type] {
  1019.         set name [quote::Prettify $m]
  1020.         lappend box -b $name $w $h [expr {$w + $wincr}] [expr {$h + 15}]
  1021.         incr w [expr {$wincr +20}]
  1022.         if {$w == $endw} {set w 20; incr h 20}
  1023.     }
  1024.     if {$w > 20} {set w 20; incr h 20}
  1025.     if {$h > $maxh} {set maxh $h}
  1026.     }
  1027.     set h $maxh
  1028.     incr h 20
  1029.     while 1 {
  1030.     set values [eval [concat dialog -w $endw -h [expr {$h + 30}] \
  1031.       -b OK 20 $h 85 [expr {$h + 20}] $box]]
  1032.     if {[lindex $values 0]} {return}
  1033.     # we hit a button
  1034.     for {set i 0} {$i < [llength $all]} {incr i} {
  1035.         if {[lindex $values [expr {$i + 2}]]} {
  1036.         if {$what == "Help"} {
  1037.             package::helpFile [lindex $all $i]
  1038.         } else {
  1039.             package::describe [lindex $all $i]
  1040.         }
  1041.         break
  1042.         }
  1043.     }
  1044.     }
  1045. }
  1046.  
  1047.  
  1048. # ◊◊◊◊ Dialog sub-panes ◊◊◊◊ #
  1049.  
  1050. set dialog::_not_global_flag ""
  1051.  
  1052. ## 
  1053.  # -------------------------------------------------------------------------
  1054.  # 
  1055.  # "dialog::flag" --
  1056.  # 
  1057.  #  Builds a dialog-box page to be used for setting global/mode/package
  1058.  #  preferences.  It can contain preferences for flags (on/off), variables,
  1059.  #  list items, mode items, files, folders, apps,...
  1060.  # 
  1061.  # Results:
  1062.  #  part of a script to generate the dialog
  1063.  # 
  1064.  # Side effects:
  1065.  #  sets maxT to the maximum height desired by the dialog
  1066.  # 
  1067.  # --Version--Author------------------Changes-------------------------------
  1068.  #    1.0     Pete Keleher             original
  1069.  #    2.0     <vince@santafe.edu> much more sophisticated (and complex!)
  1070.  # -------------------------------------------------------------------------
  1071.  ##
  1072. proc dialog::flag {flags vars {left 20} {top 40} {title {}}} {
  1073.     global maxT spelling alpha::prefNames dialog::_not_global_flag mode \
  1074.       includeDescriptionsInDialogs
  1075.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  1076.     cache::readContents index::prefshelp
  1077.     if {[info tclversion] >= 8.0} {
  1078.         upvar help help
  1079.     }
  1080.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1081.         append vprefix ","
  1082.     }
  1083.     }
  1084.     
  1085.     if {$title != ""} {
  1086.     lappend args "-t" $title 30 10 400 25
  1087.     incr top 25
  1088.     }
  1089.     # if variable names are very long, switch to 2 columns
  1090.     if {$includeDescriptionsInDialogs} {
  1091.     set perRow 1
  1092.     set width 450
  1093.     } else {
  1094.     if {[maxListItemLength $flags] > 18} {
  1095.         set perRow 2
  1096.         set width 225
  1097.     } else {
  1098.         set perRow 3
  1099.         set width 150
  1100.     
  1101.     }
  1102.     }
  1103.     set height    15
  1104.     
  1105.     set ind 0
  1106.     set l $left
  1107.     foreach f $flags {
  1108.     set fname [quote::Prettify $f]
  1109.     if {$spelling} {text::british fname}
  1110.     if {$includeDescriptionsInDialogs} {
  1111.         if {[info exists prefshelp($vprefix$f)]} {
  1112.         incr top 10
  1113.         eval lappend args [dialog::text \
  1114.           [dialog::helpdescription $prefshelp($vprefix$f)] $l top 90]
  1115.         incr top -14
  1116.         } elseif {[info exists prefshelp($mode,$f)]} {
  1117.         incr top 10
  1118.         eval lappend args [dialog::text \
  1119.           [dialog::helpdescription $prefshelp($mode,$f)] $l top 90]
  1120.         incr top -14
  1121.         }
  1122.     }
  1123.     lappend args "-c" $fname [dialog::getFlag $f] \
  1124.       $l $top [incr l $width] [expr {$top + $height}]
  1125.     if {[incr ind] % $perRow == 0} { set l $left ; incr top $height }
  1126.     if {[info tclversion] >= 8.0} {
  1127.         if {[info exists prefshelp($vprefix$f)]} {
  1128.         lappend help $prefshelp($vprefix$f)
  1129.         } elseif {[info exists prefshelp($mode,$f)]} {
  1130.         lappend help $prefshelp($mode,$f)
  1131.         } else {
  1132.         lappend help ""
  1133.         }
  1134.     }
  1135.     }
  1136.     
  1137.     if {$ind} {
  1138.     set top [expr {$top + 20}]
  1139.     lappend args -p 100 [expr {$top + 27}] 300 [expr {$top + 28}]
  1140.     } 
  1141.     
  1142.     dialog::buildSection $vars top 440 $left args alpha::prefNames
  1143.     incr top 30
  1144.     
  1145.     if {$top > $maxT} {set maxT $top}
  1146.     return $args
  1147. }
  1148.  
  1149. ## 
  1150.  # -------------------------------------------------------------------------
  1151.  # 
  1152.  # "dialog::buildSection" --
  1153.  # 
  1154.  #  Build a dialog box section for a bunch of preferences.  If 'flag_check'
  1155.  #  is set the prefs can be flags or vars, else just vars.
  1156.  #  
  1157.  #  'yvar' is a variable which contains the current y-pos in the box,
  1158.  #  and should be incremented as appropriate by this procedure.
  1159.  #  'width' is the width of the dialog box (default 420)
  1160.  #  'l' is the left indent of all the items (default 20)
  1161.  #  'dialogvar' is the variable onto which all the construction code
  1162.  #  should be lappended.  If it is not given, then this proc will
  1163.  #  return the items.
  1164.  #  'names', if given, is an array containing textual replacements for
  1165.  #  the names of the variables to be used in the box.
  1166.  #  
  1167.  #  A minimal call would be:
  1168.  #  
  1169.  #  set y 20
  1170.  #  set build [dialog::buildSection [list fillColumn] y]
  1171.  #  eval lappend build [dialog::okcancel 20 y]
  1172.  #  set res [eval dialog -w 480 -h $y $build]
  1173.  #  
  1174.  # -------------------------------------------------------------------------
  1175.  ##
  1176. proc dialog::buildSection {vars yvar {width 420} {l 20} {dialogvar ""} {names ""} {flag_check 1}} {
  1177.     global flag::list flag::type allFlags spelling alpha::colors mode::features \
  1178.       includeDescriptionsInDialogs dialog::_not_global_flag mode
  1179.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  1180.     cache::readContents index::prefshelp
  1181.     if {[info tclversion] >= 8.0} {
  1182.         upvar help help
  1183.     }
  1184.     }
  1185.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1186.     append vprefix ","
  1187.     }
  1188.     upvar $yvar t
  1189.     if {$dialogvar != ""} {upvar $dialogvar args}
  1190.     if {$names != ""} { upvar $names name }
  1191.     set height 17
  1192.     set lf 135
  1193.     set r [expr {$l + $width}]
  1194.     set rb [expr {$r -45}]
  1195.     foreach vset $vars {
  1196.     if {[llength $vset] > 1} {
  1197.         incr t 5
  1198.         if {[lindex $vset 0] != ""} {
  1199.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1200.         incr t 20
  1201.         }
  1202.         set vset [lrange $vset 1 end]
  1203.     }
  1204.     foreach v $vset {
  1205.         if {$includeDescriptionsInDialogs} {
  1206.         if {[info exists prefshelp($vprefix$v)]} {
  1207.             incr t 10
  1208.             eval lappend args [dialog::text $prefshelp($vprefix$v) $l t 90]
  1209.             incr t -14
  1210.         }
  1211.         }
  1212.         if {[info tclversion] >= 8.0} {
  1213.         if {[info exists prefshelp($vprefix$v)]} {
  1214.             lappend help $prefshelp($vprefix$v)
  1215.         } elseif {[info exists prefshelp($mode,$v)]} {
  1216.             lappend help $prefshelp($mode,$v)
  1217.         } else {
  1218.             lappend help ""
  1219.         }
  1220.         }
  1221.         
  1222.         set vv [dialog::getFlag $v]
  1223.         if {[info exists name($v)]} {
  1224.         set vname $name($v)
  1225.         } else {
  1226.         set vname [quote::Prettify $v]
  1227.         }
  1228.         if {$spelling} {
  1229.         text::british vname
  1230.         }
  1231.         if {$flag_check && [lcontains allFlags $v]} {
  1232.         lappend args "-c" $vname $vv $l $t $r [expr {$t + 15}]
  1233.         incr t 15
  1234.         continue
  1235.         }
  1236.         # attempt to indent correctly
  1237.         set len [string length $vname] 
  1238.         if {$len > 40} {
  1239.         lappend args "-t" "$vname:" $l $t [expr {$r -30}] [expr {$t + $height}]
  1240.         incr t 15
  1241.         set indent 100
  1242.         set tle ""
  1243.         } elseif {$len > 17} {
  1244.         set indent [expr {11 + 7 * $len}]
  1245.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1246.         } else {
  1247.         set indent $lf
  1248.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  1249.         }
  1250.         
  1251.         if {[info exists flag::list($v)]} {
  1252.         incr t 5
  1253.         eval lappend args $tle
  1254.         set litems [flag::options $v]
  1255.         if {[regexp "index" [lindex [set flag::list($v)] 0]]} {
  1256.             # set item to index, making sure bad values don't error
  1257.             if {[catch {lindex $litems $vv} vv]} { set vv [lindex $litems 0] }
  1258.         }
  1259.         lappend args "-m" [concat [list $vv] $litems] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1260.         incr t 17
  1261.         } elseif {[regexp "Colou?r$" $v]} {
  1262.         incr t 5
  1263.         eval lappend args $tle
  1264.         lappend args "-m" [concat [list $vv] ${alpha::colors}] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  1265.         incr t 17
  1266.         } elseif {[regexp "Mode$" $v]} {
  1267.         incr t 5
  1268.         eval lappend args $tle
  1269.         if {$vv == ""} { set vv "<none>" }
  1270.         lappend args "-m" [concat [list $vv] [concat "<none>" [lsort [array names mode::features]]]] [expr {$l + $indent -2}] $t [expr {$r - 14}] [expr {$t + $height +1}]
  1271.         incr t 17
  1272.         } elseif {[regexp "Sig$" $v]} {
  1273.         eval lappend args $tle
  1274.         set vv [dialog::specialView_Sig $vv]
  1275.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1276.         eval lappend args [dialog::buttonSet $rb $t]
  1277.         incr t 17
  1278.         } elseif {[regexp "SearchPath$" $v]} {
  1279.         eval lappend args $tle
  1280.         if {$vv == ""} {
  1281.             lappend args "-t" "No search paths currently set." \
  1282.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1283.             eval lappend args [dialog::buttonSet $rb $t]
  1284.             incr t 17
  1285.         } else {
  1286.             eval lappend args [dialog::buttonSet $rb $t]
  1287.             foreach ppath $vv {
  1288.             lappend args "-t" [dialog::specialView_file $ppath] \
  1289.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1290.             incr t 17
  1291.             }
  1292.         }
  1293.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1294.         eval lappend args $tle
  1295.         set vv [dialog::specialView_file $vv]
  1296.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1297.         eval lappend args [dialog::buttonSet $rb $t]
  1298.         incr t 17
  1299.         } elseif {[info exists flag::type($v)]} {
  1300.         if {[set flag::type($v)] == "funnyChars"} {
  1301.             set vv [quote::Display $vv]
  1302.             set eh [expr {1 + [string length $vv] / 60}]
  1303.             incr t [expr {7 * $eh}]
  1304.             eval lappend args $tle
  1305.             incr t [expr {5 -7 * $eh}]
  1306.             lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1307.             incr t [expr {5 + 17 * $eh}]
  1308.         } else {
  1309.             eval lappend args $tle
  1310.             set vv [dialog::specialView_[set flag::type($v)] $vv]
  1311.             lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  1312.             eval lappend args [dialog::buttonSet $rb $t]            
  1313.             incr t 17
  1314.         }
  1315.         } else {
  1316.         set eh [expr {1 + [string length $vv] / 60}]
  1317.         incr t [expr {7 * $eh}]
  1318.         eval lappend args $tle
  1319.         incr t [expr {5 -7 * $eh}]
  1320.         lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  1321.         incr t [expr {5 + 17 * $eh}]
  1322.         }
  1323.     }
  1324.     }
  1325.     if {$dialogvar == ""} {return $args}
  1326. }
  1327. proc dialog::multipage {data} {
  1328.     dialog::resetModified
  1329.     global maxT
  1330.     # in case internal 'command-buttons' are used in the dialog
  1331.     while 1 {
  1332.     
  1333.     set left 20   
  1334.     
  1335.     set names {}
  1336.     set editItems {}
  1337.     set cmd ""
  1338.     set maxT 0
  1339.     foreach arg [lsort $data] {
  1340.         if {[llength $arg] != 3} {error "Bad structure"}
  1341.         lappend names [lindex $arg 0]
  1342.         set flags [lindex $arg 1]
  1343.         set vars [lindex $arg 2]
  1344.         lappend editItems [eval list $flags $vars]
  1345.         eval lappend cmd "-n" [list [lindex $arg 0]] [dialog::flag $flags $vars]
  1346.     }
  1347.     
  1348.     set buttons [dialog::okcancel $left maxT]
  1349.     set height $maxT
  1350.     if {![info exists chosenName]} {set chosenName [lindex $names 0]}
  1351.     if {[info exists help]} {
  1352.         set res [eval [concat dialog -w 480 -h $height \
  1353.           -t "Preferences:" 40 10 125 30 $buttons \
  1354.           -b "Help" 410 10 460 28 \
  1355.           [list -m [concat [list $chosenName] $names] 140 8 405 30] \
  1356.           $cmd -help] [list [concat [list \
  1357.           "Click here to save the current settings." \
  1358.           "Click here to discard any changes you've made to the settings." \
  1359.           "Click here to display textual help on each item in this dialog." \
  1360.           "Use this popup menu, or the cursor keys to select a \
  1361.           different page of preferences."] $help]]]
  1362.     } else {
  1363.         set res [eval [concat dialog -w 480 -h $height \
  1364.           -t "Preferences:" 40 10 125 30 $buttons \
  1365.           -b "Help" 410 10 460 28 \
  1366.           [list -m [concat [list $chosenName] $names] 140 8 405 30] \
  1367.           $cmd]]
  1368.     }
  1369.     
  1370.     set chosenName [lindex $res 3]
  1371.     if {[lindex $res 0]} {
  1372.         return [list [lrange $res 4 end] [eval concat $editItems]]
  1373.     } else {
  1374.         if {[lindex $res 1]} {
  1375.         error "Cancel chosen"
  1376.         }
  1377.         dialog::rememberChanges [list [lrange $res 4 end] [eval concat $editItems]]
  1378.         # Either help, or some set or describe type button was pressed
  1379.         # We need to ensure we remember anything the user has already
  1380.         # changed.
  1381.         if {[lindex $res 2]} {
  1382.         # help pressed
  1383.         set i [lsearch -exact $names [lindex $res 3]]
  1384.         dialog::describe [lindex $editItems $i] "Description of [lindex $res 3] prefs"
  1385.         } else {
  1386.         # a 'set…' button was pressed
  1387.         dialog::handleSet [lrange $res 4 end] [eval concat $editItems]
  1388.         }
  1389.     }
  1390.     # end of large while loop
  1391.     }
  1392.  
  1393. }
  1394.  
  1395. proc dialog::rememberChanges {values_items} {
  1396.     set res [lindex $values_items 0]
  1397.     set editItems [lindex $values_items 1]
  1398.     unset values_items
  1399.     foreach fset $editItems {
  1400.     if {[llength $fset] > 1} {
  1401.         set fset [lrange $fset 1 end]
  1402.     }
  1403.     foreach flag $fset {
  1404.         set val [lindex $res 0]
  1405.         set res [lrange $res 1 end]
  1406.         dialog::postManipulate
  1407.         dialog::modified $flag $val
  1408.     }
  1409.     }
  1410. }
  1411.  
  1412. proc dialog::onepage {flags vars {title ""}} {
  1413.     dialog::resetModified
  1414.     global maxT
  1415.     while 1 {
  1416.     set left 20
  1417.     set maxT 0
  1418.     set args [dialog::flag $flags $vars 20 10 $title]
  1419.     set height [expr {$maxT + 30}]
  1420.     set buttons [dialog::okcancel $left maxT]
  1421.     set height $maxT
  1422.     if {[info exists help]} {
  1423.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1424.           -b "Help" 410 10 460 28 $args -help] \
  1425.           [list [concat [list \
  1426.           "Click here to save the current settings." \
  1427.           "Click here to discard any changes you've made to the settings." \
  1428.           "Click here to display textual help on each item in this dialog." \
  1429.           ] $help]]]
  1430.     } else {
  1431.         set res [eval [concat dialog -w 480 -h $height $buttons \
  1432.           -b "Help" 410 10 460 28 $args]]
  1433.     }
  1434.     
  1435.     if {[lindex $res 0]} {
  1436.         return [list [lrange $res 3 end] [concat $flags $vars]]
  1437.     } else {
  1438.         
  1439.         if {[lindex $res 1]} {
  1440.         error "Cancel chosen"
  1441.         } 
  1442.         dialog::rememberChanges [list [lrange $res 3 end] [concat $flags $vars]]
  1443.         if {[lindex $res 2]} {
  1444.         # help
  1445.         dialog::describe [concat $flags $vars] $title
  1446.         } else {
  1447.         dialog::handleSet [lrange $res 3 end] [concat $flags $vars]
  1448.         }
  1449.     }
  1450.     # big while loop end
  1451.     }
  1452.     
  1453. }
  1454.  
  1455. proc dialog::describe {vars {title ""}} {
  1456.     if {$title == ""} {
  1457.     set title "Preferences description"
  1458.     }
  1459.     global flag::list flag::type spelling alpha::colors \
  1460.       dialog::_not_global_flag mode
  1461.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  1462.     append vprefix ","
  1463.     }
  1464.     cache::readContents index::prefshelp
  1465.     set height 17
  1466.     set lf 135
  1467.     set l 20
  1468.     set width 420
  1469.     set r [expr {$l + $width}]
  1470.     set rb [expr {$r -45}]
  1471.     set args {}
  1472.     set t 35
  1473.     set height 0
  1474.     set page 1
  1475.     set pages {}
  1476.     foreach vset $vars {
  1477.     if {[llength $vset] > 1} {
  1478.         incr t 5
  1479.         if {[lindex $vset 0] != ""} {
  1480.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  1481.         incr t 20
  1482.         }
  1483.         set vset [lrange $vset 1 end]
  1484.     } else {
  1485.         #do this so that vars that have whitespace padding (used to force dialog position)
  1486.         # are not strip of that space in the next "foreach" statement
  1487.         set vset [list [set vset]]
  1488.     }
  1489.     foreach v $vset {
  1490.         set vv [dialog::getFlag $v]
  1491.         if {[info exists name($v)]} {
  1492.         set vname $name($v)
  1493.         } else {
  1494.         set vname [quote::Prettify $v]
  1495.         }
  1496.         if {$spelling} {
  1497.         text::british vname
  1498.         }
  1499.         if {[info exists prefshelp($vprefix$v)]} {
  1500.         append vname ": " [dialog::helpdescription $prefshelp($vprefix$v)]
  1501.         } elseif {[info exists prefshelp($mode,$v)]} {
  1502.         append vname ": " [dialog::helpdescription $prefshelp($mode,$v)]
  1503.         } else {
  1504.         append vname ": no description"
  1505.         }
  1506.         eval lappend args [dialog::text $vname $l t 60]
  1507.         if {$t > 360} {
  1508.         # make another page
  1509.         eval lappend pages -n [list "Page $page"] $args
  1510.         set args {}
  1511.         incr page
  1512.         if {$t > $height} {set height $t}
  1513.         set t 35
  1514.         }
  1515.         
  1516.     }
  1517.     
  1518.     }
  1519.     if {$page > 1} {
  1520.     set t $height
  1521.     set height [expr {$t + 40}]
  1522.     for {set i 1} {$i <= $page} {incr i} {
  1523.         lappend names "Page $i"
  1524.     }
  1525.     eval lappend pages -n [list "Page $page"] $args        
  1526.     set res [eval [concat dialog -w 480 -h $height \
  1527.       -t [list $title] 60 10 $width 30 \
  1528.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] \
  1529.       [list -m [concat [list [lindex $names 0]] $names] 400 10 475 30] $pages]]
  1530.     } else {
  1531.     set height [expr {$t + 40}]
  1532.     set res [eval [concat dialog -w 480 -h $height \
  1533.       -t [list $title] 60 10 $width 30 \
  1534.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] $args]]
  1535.     }
  1536. }
  1537.  
  1538. proc dialog::helpdescription {hlp} {
  1539.     set hlp [split $hlp |]
  1540.     if {[llength $hlp] <= 1} {
  1541.     return [lindex $hlp 0]
  1542.     }
  1543.     set res ""
  1544.     for {set hi 0} {$hi < [llength $hlp]} {incr hi} {
  1545.     set hitem [lindex $hlp $hi]
  1546.     if {$hitem != ""} {
  1547.         if {$hi == 0} {
  1548.         regsub "click this box\\.?" $hitem "turn this item on" hitem
  1549.         } elseif {$hi == 2} {
  1550.         regsub "click this box\\.?" $hitem "turn this item off" hitem
  1551.         }
  1552.         append res $hitem ". "
  1553.     }
  1554.     }
  1555.     return $res
  1556. }
  1557.  
  1558. # ◊◊◊◊ Dialog utilities ◊◊◊◊ #
  1559. proc dialog::handleSet {res names} {
  1560.     # to account for sub-lists in the list of names
  1561.     foreach n $names {
  1562.     if {[llength $n] > 1} {
  1563.         eval lappend newnames [lrange $n 1 end]
  1564.     } else {
  1565.         lappend newnames $n
  1566.     }
  1567.     }
  1568.     set names $newnames
  1569.     unset newnames
  1570.     global flag::type
  1571.     # a 'set…' button was pressed
  1572.     for {set i 0} {$i < [llength $names]} {incr i} {
  1573.     if {[lindex $res $i] == 1} {
  1574.         set v [lindex $names $i]
  1575.         if {[regexp "SearchPath$" $v]} {
  1576.         set res [buttonAlert "Perform what action to one of the [quote::Prettify $v]s" "Add" "Remove" "Change" "Cancel"]
  1577.         switch -- $res {
  1578.             "Add" {
  1579.             # this set… pressed
  1580.             if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1581.                 set newval [concat [dialog::getFlag $v] [list $newval]] 
  1582.                 dialog::modified $v $newval
  1583.             }
  1584.             }
  1585.             "Remove" {
  1586.             if {![catch {set remove [listpick -p "Remove which items from [quote::Prettify $v]:" -l [dialog::getFlag $v]]}]} {
  1587.                 # remove them
  1588.                 set newval [lremove -l [dialog::getFlag $v] $remove] 
  1589.                 dialog::modified $v $newval
  1590.             }
  1591.             }
  1592.             "Change" {
  1593.             if {![catch {set change [listpick -p "Change which item from [quote::Prettify $v]:" [dialog::getFlag $v]]}]} {
  1594.                 # change it
  1595.                 if {![catch {get_directory -p "Replacement [quote::Prettify $v]:"} newval]} {
  1596.                 set old [dialog::getFlag $v]
  1597.                 set i [lsearch -exact $old $change]
  1598.                 set old [lreplace $old $i $i $newval]
  1599.                 dialog::modified $v $old
  1600.                 }
  1601.             }
  1602.             }
  1603.         }
  1604.         break
  1605.         } elseif {[regexp "(Path|Folder)$" $v]} {
  1606.         # this set… pressed
  1607.         if {![catch {get_directory -p "New [quote::Prettify $v]:"} newval]} {
  1608.             dialog::modified $v $newval
  1609.         }
  1610.         break
  1611.         } elseif {[info exists flag::type($v)]} {
  1612.         dialog::specialSet_[set flag::type($v)] $v
  1613.         break
  1614.         } elseif {[regexp "Sig$" $v]} {
  1615.         global $v
  1616.         set newval [dialog::findApp $v [set $v]]
  1617.         if {$newval != ""} {
  1618.             dialog::modified $v $newval
  1619.         }
  1620.         break
  1621.         }  
  1622.     }
  1623.     }
  1624. }
  1625.  
  1626. proc dialog::setFlag {name val} {
  1627.     global dialog::_not_global_flag
  1628.     if {${dialog::_not_global_flag} != ""} {
  1629.     global ${dialog::_not_global_flag}
  1630.     set ${dialog::_not_global_flag}($name) $val
  1631.     } else {
  1632.     global $name
  1633.     set $name $val
  1634.     }    
  1635. }
  1636.  
  1637. proc dialog::getFlag {name} {
  1638.     global dialog::_modified
  1639.     if {[info exists dialog::_modified($name)]} { 
  1640.     return [set dialog::_modified($name)] 
  1641.     } else {
  1642.     return [dialog::getOldFlag $name]
  1643.     }
  1644. }
  1645. proc dialog::getOldFlag {name} {
  1646.     global dialog::_not_global_flag
  1647.     if {${dialog::_not_global_flag} != ""} {
  1648.     global ${dialog::_not_global_flag}
  1649.     return [set ${dialog::_not_global_flag}($name)]
  1650.     } else {
  1651.     global dialog::_is_global
  1652.     if {[info exists dialog::_is_global]} {
  1653.         global global::_vars
  1654.         if {[info exists global::_vars] \
  1655.           && [set i [lsearch ${global::_vars} $name]] != -1} {
  1656.         return [lindex ${global::_vars} [incr i]]
  1657.         } 
  1658.     }
  1659.     }    
  1660.     global $name
  1661.     if {[info exists $name]} { 
  1662.     return [set $name]
  1663.     } else { 
  1664.     alertnote "Global variable '$name' in the dialog isn't set.\r\
  1665.       I'll try to fix that."
  1666.     return [set $name ""]
  1667.     }
  1668. }
  1669.  
  1670. proc dialog::is_global {script} {
  1671.     global dialog::_is_global
  1672.     set dialog::_is_global 1
  1673.     catch "[list uplevel $script]"
  1674.     unset dialog::_is_global
  1675. }
  1676. proc dialog::resetModified {} {
  1677.     global dialog::_modified
  1678.     if {[info exists dialog::_modified]} {
  1679.     unset dialog::_modified
  1680.     }
  1681. }
  1682.  
  1683. proc dialog::global_adjust_flags {values_items} {
  1684.     global flag::procs modifiedVars global::_vars
  1685.     set res [lindex $values_items 0]
  1686.     set editItems [lindex $values_items 1]
  1687.     unset values_items
  1688.     foreach fset $editItems {
  1689.     if {[llength $fset] > 1} {
  1690.         set fset [lrange $fset 1 end]
  1691.     }
  1692.     foreach flag $fset {
  1693.         set val [lindex $res 0]
  1694.         set res [lrange $res 1 end]
  1695.         dialog::postManipulate
  1696.         if {[info exists global::_vars] \
  1697.           && [set i [lsearch ${global::_vars} $flag]] != -1} {
  1698.         set orig [lindex ${global::_vars} [incr i]]
  1699.         if {$orig != $val} {
  1700.             set global::_vars [lreplace ${global::_vars} $i $i $val]
  1701.             lappend warn_global $flag
  1702.         }
  1703.         } else {
  1704.         global $flag
  1705.         set orig [set $flag]
  1706.         if {$orig != $val} {
  1707.             set $flag $val
  1708.         }
  1709.         }
  1710.         if {$orig != $val} {
  1711.         if {[info exists flag::procs($flag)]} {
  1712.             set proc [set flag::procs($flag)]
  1713.             if {([info procs $proc] != "") && ([llength [info args $proc]] == 0)} {
  1714.             eval $proc
  1715.             } else {
  1716.             eval $proc [list $flag]
  1717.             }
  1718.         }
  1719.         lappend modifiedVars $flag
  1720.         }
  1721.     }
  1722.     }
  1723.     if {[info exists warn_global]} {
  1724.     if {[llength $warn_global] == 1} {
  1725.         set msg "is a global pref"
  1726.     } else {
  1727.         set msg "are global prefs"
  1728.     }
  1729.     alertnote "You modified [join $warn_global {, }] which $msg,\
  1730.       but currently over-ridden by mode-specific values.  If you meant to\
  1731.       modify the latter values, use the mode prefs dialog."
  1732.     }
  1733. }
  1734.  
  1735. proc dialog::postManipulate {} {
  1736.     global flag::list flag::type
  1737.     upvar flag f
  1738.     upvar val v
  1739.     
  1740.     if {[info exists flag::list($f)]} {
  1741.     switch -- [lindex [set l [set flag::list($f)]] 0] {
  1742.         "index" {
  1743.         set v [lsearch -exact [lindex $l 1] $v]
  1744.         }
  1745.         "varindex" {
  1746.         set itemv [lindex $l 1]
  1747.         global $itemv
  1748.         set v [lsearch -exact [set $itemv] $v]
  1749.         }
  1750.     }
  1751.     }
  1752.     if {$v == "<none>" && [regexp "Mode$" $f]} { set v "" }
  1753.     # This check also captures any 'dialog::modified' items
  1754.     # This allows flags which are somehow already set by the
  1755.     # dialog (for instance if called recursively, or if set by embedded
  1756.     # 'Set…' buttons) to be registered as modifed by our calling procedure.
  1757.     if {[regexp "(Path|Folder|Sig)$" $f]} {
  1758.     set v [dialog::getFlag $f]
  1759.     } elseif {[info exists flag::type($f)]} {
  1760.     switch -- [set flag::type($f)] {
  1761.         "binding" {
  1762.         # setup the changed binding
  1763.         set old [dialog::getOldFlag $f]
  1764.         set v [dialog::getFlag $f]
  1765.         if {$old != $v} {
  1766.             global flag::binding
  1767.             if {[info exists flag::binding($f)]} {
  1768.             set m [lindex [set flag::binding($f)] 0]
  1769.             if {[set proc [lindex [set flag::binding($f)] 1]] == 1} {
  1770.                 set proc $f
  1771.             }
  1772.             catch "unBind [keys::toBind $old] [list $proc] $m"
  1773.             catch "Bind [keys::toBind $v] [list $proc] $m"
  1774.             }
  1775.         }
  1776.         }
  1777.         "funnyChars" {
  1778.         set v [quote::Undisplay $v]
  1779.         }
  1780.         default {
  1781.         set v [dialog::getFlag $f]
  1782.         }
  1783.     }
  1784.     }
  1785. }
  1786.  
  1787. proc dialog::modified {name val} {
  1788.     global dialog::_modified
  1789.     set dialog::_modified($name) $val
  1790. }
  1791.  
  1792. # Used on modified mode flags.
  1793. set flag::procs(stringColor) "stringColorProc"
  1794. set flag::procs(commentColor) "stringColorProc"
  1795. set flag::procs(keywordColor) "stringColorProc"
  1796. set flag::procs(funcColor) "stringColorProc"
  1797. set flag::procs(sectionColor) "stringColorProc"
  1798. set flag::procs(bracesColor) "stringColorProc"
  1799.  
  1800. proc global::updateHelperFlags {} {
  1801.     uplevel #0 {
  1802.     set "flagPrefs(Helper Applications)" {}
  1803.     set "varPrefs(Helper Applications)" [info globals *Sig]
  1804.     }
  1805. }
  1806.  
  1807. proc global::updatePackageFlags {} {
  1808.     global flagPrefs varPrefs allFlags modeVars allVars
  1809.     # flags can be in either flagPrefs or varPrefs if we're grouping
  1810.     # preferences according to function
  1811.     set all {}
  1812.     set flagPrefs(Packages) {}
  1813.     set varPrefs(Packages) {}
  1814.     foreach v [array names flagPrefs] {
  1815.     eval lappend all $flagPrefs($v)
  1816.     if {[info exists varPrefs($v)]} {
  1817.         if {[regexp {[{}]} $varPrefs($v)]} {
  1818.         # we're grouping
  1819.         foreach i $varPrefs($v) {
  1820.             if {[llength $i] > 1} {
  1821.             eval lappend all [lrange $i 1 end]
  1822.             } else {
  1823.             lappend all $i
  1824.             }
  1825.         }
  1826.         } else {
  1827.         eval lappend all $varPrefs($v)
  1828.         }
  1829.     }
  1830.     }
  1831.     foreach f $allFlags {
  1832.     if {([lsearch $modeVars $f] < 0)} {
  1833.         if {[lsearch -exact $all $f] == -1} {
  1834.         lappend flagPrefs(Packages) $f
  1835.         }
  1836.     }
  1837.     }
  1838.     
  1839.     foreach f $allVars {
  1840.     if {([lsearch $modeVars $f] < 0)} {
  1841.         if {[lsearch -exact $all $f] == -1} {
  1842.         if {[regexp {Sig$} $f]} {
  1843.             lappend "varPrefs(Helper Applications)" $f
  1844.         } else {
  1845.             lappend varPrefs(Packages) $f
  1846.         }
  1847.         }
  1848.     }
  1849.     }
  1850. }
  1851.  
  1852. #================================================================================
  1853.  
  1854. proc maxListItemLength {l} {
  1855.     set m 0
  1856.     foreach item $l {
  1857.     if {[set mm [string length $item]] > $m} { set m $mm }
  1858.     }
  1859.     return $m
  1860. }
  1861.  
  1862. proc stringColorProc {flag} {
  1863.     global $flag mode
  1864.     
  1865.     if {[set $flag] == "none"} {
  1866.         set $flag "foreground"
  1867.     }
  1868.     if {$flag == "stringColor"} {
  1869.         regModeKeywords -a -s $stringColor $mode
  1870.     } elseif {$flag == "commentColor"} {
  1871.         regModeKeywords -a -c $commentColor $mode
  1872.     } elseif {$flag == "funcColor"} {
  1873.         regModeKeywords -a -f $funcColor $mode
  1874.     } elseif {$flag == "bracesColor"} {
  1875.         regModeKeywords -a -I $bracesColor $mode
  1876.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  1877.         alertnote "Change in keyword color will take effect after Alpha restarts."
  1878.         return
  1879.     } else {
  1880.         alertnote "Change in $flag color will take effect after Alpha restarts."
  1881.         return
  1882.     }
  1883.     refresh
  1884. }
  1885.  
  1886. # ◊◊◊◊ Dialog sub-items ◊◊◊◊ #
  1887.  
  1888. proc dialog::buttonSet {x y} {
  1889.     return [list -b Set… $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1890. }
  1891.  
  1892. proc dialog::okcancel {x yy {vertical 0}} {
  1893.     upvar $yy y
  1894.     set i [dialog::button "OK" $x y]
  1895.     if {!$vertical} {
  1896.     incr y -30
  1897.     incr x 80
  1898.     }
  1899.     eval lappend i [dialog::button "Cancel" $x y]
  1900.     return $i
  1901. }
  1902.  
  1903. proc dialog::menu {x yy item {def "def"} {requestedWidth 0}} { 
  1904.     upvar $yy y
  1905.     set m [concat [list $def] $item]
  1906.     if {$requestedWidth == 0} {
  1907.     set popUpWidth 340
  1908.     } else {
  1909.     set popUpWidth $requestedWidth 
  1910.     }
  1911.     
  1912.     if {[info tclversion] < 8.0} {
  1913.     set res [list -m $m $x $y [expr {$x + $popUpWidth}] [expr {$y +20}]]
  1914.     incr y 20
  1915.     } else {
  1916.     incr y -1
  1917.     set res [list -m $m $x $y [expr {$x + $popUpWidth}] [expr {$y +19}]]
  1918.     incr y 21
  1919.     }
  1920.     return $res
  1921. }
  1922. ## 
  1923.  # -------------------------------------------------------------------------
  1924.  # 
  1925.  # "dialog::button" --
  1926.  # 
  1927.  #  Create a dialog string encoding one or more buttons.  'name' is the
  1928.  #  name of the button ("Ok" etc), x is the x position, or if x is null,
  1929.  #  then we use the variable called 'x' in the calling procedure.  yy is
  1930.  #  the name of a variable containing the y position of the button, which
  1931.  #  will be incremented by this procedure.  if args is non-null, it
  1932.  #  contains further name-x-yy values to be lines up next to this button.
  1933.  #  For sequences of default buttons, a spacing of '80' is usual, but
  1934.  #  it's probably best if you just set the 'x' param to "" and let this
  1935.  #  procedure calculate them for you.  See dialog::yesno for a good
  1936.  #  example of calling this procedure.
  1937.  # -------------------------------------------------------------------------
  1938.  ##
  1939. proc dialog::button {name x yy args} { 
  1940.     upvar $yy y
  1941.     if {$x == ""} {
  1942.     unset x
  1943.     upvar x x
  1944.     }
  1945.     set add 65
  1946.     if {[set i [expr {[string length $name] - 7}]] > 0} { 
  1947.     incr add [expr {$i * 7}]
  1948.     }
  1949.     set res [list -b $name $x $y [expr {$x +$add}] [expr {$y +20}]]
  1950.     incr x $add
  1951.     incr x 15
  1952.     if {[llength $args]} {
  1953.     eval lappend res [eval dialog::button $args]
  1954.     return $res
  1955.     }
  1956.     incr y 30
  1957.     return $res
  1958. }
  1959. proc dialog::title {name w} {
  1960.     set l [expr {${w}/2 - 4 * [string length $name]}]
  1961.     if {$l < 0} {set l 0}
  1962.     return [list -t $name $l 10 [expr {$w - $l}] 25]
  1963. }
  1964. ## 
  1965.  # -------------------------------------------------------------------------
  1966.  # 
  1967.  # "dialog::text" --
  1968.  # 
  1969.  #  Creates a text box wrapping etc the text to fit appropriately.
  1970.  #  In the input text 'name', "\r" is used as a paragraph delimiter,
  1971.  #  and "\n" is used to force a linebreak.  Paragraphs have a wider
  1972.  #  spread.
  1973.  # -------------------------------------------------------------------------
  1974.  ##
  1975. proc dialog::text {name x yy {split 0}} {
  1976.     upvar $yy y
  1977.     if {!$split || $name == ""} {
  1978.     set res [list -t $name $x $y [expr {$x + 7 * [string length $name]}] \
  1979.       [expr {$y +15}]]
  1980.     incr y 18
  1981.     } else {
  1982.     global fillColumn
  1983.     if {[info exists fillColumn]} {
  1984.         set f $fillColumn
  1985.     }
  1986.     set fillColumn $split
  1987.     set name [string trim $name]
  1988.     set paragraphList [split $name "\r"]
  1989.     foreach para $paragraphList {
  1990.         set lines ""
  1991.         foreach line [split $para "\n"] {
  1992.         lappend lines [breakIntoLines $line]
  1993.         }
  1994.         set lines [join $lines "\r"]
  1995.         foreach line [split $lines "\r"] {
  1996.         eval lappend res [list -t $line $x $y [expr {$x + 4+ 8 * [string length $line]}] \
  1997.           [expr {$y +15}]]
  1998.         incr y 18
  1999.         }
  2000.         incr y 10
  2001.     }
  2002.     if {[info exists f]} {
  2003.         set fillColumn $f
  2004.     } else {
  2005.         unset fillColumn
  2006.     }
  2007.     }
  2008.     return $res
  2009. }
  2010. proc dialog::edit {name x yy chars {cols 1}} {
  2011.     upvar $yy y
  2012.     set res [list -e $name $x $y [expr {$x + 10 * $chars}] [expr {$y + 15 * $cols}]]
  2013.     incr y [expr {5 + 15*$cols}]
  2014.     return $res
  2015. }
  2016. proc dialog::textedit {name default x yy chars {height 1} {horiz 0}} {
  2017.     upvar $yy y
  2018.     set xx [dialog::_reqWidth $name]
  2019.     set res [list -t $name $x $y [expr {$x + $xx}]\
  2020.       [expr {$y +16}] -e $default]
  2021.     if {$horiz} {
  2022.     incr x $horiz
  2023.     } else {
  2024.     incr y 20
  2025.     }
  2026.     lappend res $x $y [expr {$x + 10 * $chars}] \
  2027.       [expr {$y + 16*$height}]
  2028.     incr y [expr {4 + 16*$height}]
  2029.     return $res
  2030. }
  2031. proc dialog::checkbox {name default x yy} {
  2032.     upvar $yy y
  2033.     set res [list -c $name $default $x $y]
  2034.     lappend res [expr {$x + [dialog::_reqWidth $name]}] [expr {$y +15}]
  2035.     incr y 18
  2036.     return $res
  2037. }
  2038.  
  2039. if {${alpha::platform} == "alpha"} {
  2040.     proc dialog::_reqWidth {args} {
  2041.     set w 0
  2042.     foreach name $args {
  2043.         set c [regsub -all -nocase {[wm]} $name "" ""]
  2044.     set d [regsub -all {[ iIl',;:.]} $name "" ""]
  2045.     set len [expr {10 * [string length $name] + 6 * $c - 5 * $d}]
  2046.     if {[string length $name] < 7} {incr len 6}
  2047.     if {$len > $w} {
  2048.         set w $len
  2049.         }
  2050.     }
  2051.     return $w
  2052.     }
  2053. } else {
  2054.     proc dialog::_reqWidth {args} {return 0}
  2055. }
  2056.  
  2057.  
  2058. # ◊◊◊◊ Multiple bindings dialogs ◊◊◊◊ #
  2059.  
  2060. proc dialog::arrayBindings {name array {for_menu 0}} {
  2061.     upvar $array a
  2062.     foreach n [array names a] {
  2063.     lappend l [list $a($n) $n]
  2064.     }
  2065.     if {[info exists l]} {
  2066.     eval dialog::adjustBindings [list $name modified "" $for_menu] $l
  2067.     }
  2068.     array set a [array get modified]
  2069. }
  2070.  
  2071. ## 
  2072.  # -------------------------------------------------------------------------
  2073.  # 
  2074.  # "dialog::adjustBindings" --
  2075.  # 
  2076.  #  'args' is a list of pairs.  The first element of each pair is the 
  2077.  #  menu binding, and the second element is a descriptive name for the
  2078.  #  element. 'array' is the name of an array in the calling proc's
  2079.  #  scope which is used to return modified bindings.
  2080.  # 
  2081.  # Results:
  2082.  #  
  2083.  # --Version--Author------------------Changes-------------------------------
  2084.  #    1.0     Johan Linde               original for html mode
  2085.  #    1.1     <vince@santafe.edu> general purpose version
  2086.  #    1.2     Johan Linde              split into two pages when many items
  2087.  # -------------------------------------------------------------------------
  2088.  ##
  2089. proc dialog::adjustBindings {name array {mod {}} {for_menu 1} args} {
  2090.     global screenHeight
  2091.     regsub -all {\"\(-\"} $args "" items
  2092.     upvar $array key_changes
  2093.     
  2094.     foreach it $items {
  2095.     if {[info exists key_changes([lindex $it 1])]} {
  2096.         set tmpKeys([lindex $it 1]) $key_changes([lindex $it 1])
  2097.     } else {
  2098.         set tmpKeys([lindex $it 1]) [lindex $it 0]
  2099.     }
  2100.     }
  2101.     # do we return modified stuff?
  2102.     if {$mod != ""} { upvar $mod modified }
  2103.     set modified ""
  2104.     set page "Page 1 of $name"
  2105.     while {1} {
  2106.     # Build dialog.
  2107.     set twoWindows 0
  2108.     set box ""
  2109.     set h 30
  2110.     foreach it $items {
  2111.         if {$it == "(-"} {continue}
  2112.         set w 210
  2113.         set w2 370
  2114.         set key $tmpKeys([lindex $it 1])
  2115.         set key1 [dialog::specialView_binding $key]
  2116.         set it2 [split [lindex $it 1] /]
  2117.         if {[llength $it2] == 1} {
  2118.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2119.         eval lappend box [dialog::buttonSet 10 $h]
  2120.         incr h 17
  2121.         } else {
  2122.         lappend box -t [lindex $it2 0] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2123.         eval lappend box [dialog::buttonSet 10 [expr {$h +8}]]
  2124.         incr h 17
  2125.         if {$key1 != "<no binding>"} {regsub {((ctrl-)?(shift-)?)(.*)} $key1 {\1opt-\4} key1}
  2126.         lappend box -t [lindex $it2 1] 65 $h 205 [expr {$h + 15}] -t $key1 $w $h $w2 [expr {$h + 15}]
  2127.         incr h 17
  2128.         }
  2129.         if {$it != [lindex $items [expr {[llength $items] -1}]] && !$twoWindows && [set twoWindows [expr {$h + 100 > $screenHeight}]]} {
  2130.         set box " -n [list [concat Page 1 of $name]] $box -n [list [concat Page 2 of $name]] "
  2131.         set hmax $h; set h 30
  2132.         }
  2133.     }
  2134.     if {[info exists hmax]} {set h $hmax}
  2135.     if {$twoWindows} {
  2136.         set top "-m [list [list $page [concat Page 1 of $name] [concat Page 2 of $name]]] 10 10 370 25"
  2137.     } else {
  2138.         set top "-t [list $name] 50 10 250 25"
  2139.     }
  2140.     set buttons "-b OK 20 [expr {$h + 10}] 85 [expr {$h + 30}]  -b Cancel 105 [expr {$h + 10}] 170 [expr {$h + 30}]"
  2141.     set values [eval [concat dialog -w 380 -h [expr {$h + 40}]  $buttons $top $box]]
  2142.     if {$twoWindows} {set page [lindex $values 2]}
  2143.     if {[lindex $values 1]} {
  2144.         # Cancel
  2145.         return "Cancel"
  2146.     } elseif {[lindex $values 0]} {
  2147.         # Save new key bindings
  2148.         foreach it $modified {
  2149.         set key_changes($it) $tmpKeys($it)
  2150.         }
  2151.         return
  2152.     } else {
  2153.         # Get a new key.
  2154.         set it [lindex [lindex $items [expr {[lsearch $values 1] - 2 - $twoWindows}]] 1]
  2155.         if {![catch {dialog::getAKey $it $tmpKeys($it) $for_menu} newKey]  && $newKey != $tmpKeys($it)} {
  2156.         set tmpKeys($it) $newKey
  2157.         lappend modified $it
  2158.         }
  2159.     }
  2160.     }
  2161. }
  2162.  
  2163. # ◊◊◊◊ Manipulation of special pref types ◊◊◊◊ #
  2164.  
  2165. proc dialog::specialView_binding {key} {
  2166.     append key1 [keys::modifiersTo $key "verbose"]
  2167.     append key1 [keys::verboseKey $key]
  2168.     if {$key1 == ""} { return "<no binding>" }
  2169.     return $key1
  2170. }
  2171.  
  2172. proc dialog::specialSet_binding {v {menu 0}} {
  2173.     # Set… pressed
  2174.     set oldB [dialog::getFlag $v]
  2175.     if {![catch {dialog::getAKey [quote::Prettify $v] $oldB $menu} newKey] && $newKey != $oldB} {
  2176.     dialog::modified $v $newKey
  2177.     }
  2178. }
  2179.  
  2180. proc dialog::specialView_menubinding {key} {
  2181.     dialog::specialView_binding $key
  2182. }
  2183.  
  2184. proc dialog::specialSet_menubinding {v} {
  2185.     dialog::specialSet_binding $v 1
  2186. }
  2187. proc dialog::specialView_Sig {vv} {
  2188.     if {$vv != ""} {
  2189.     if {[catch {nameFromAppl $vv} path]} {
  2190.         return "Unknown application with sig '$vv'"
  2191.     } else {
  2192.         return [dialog::specialView_file $path]
  2193.     }
  2194.     }
  2195.     return ""
  2196. }
  2197.  
  2198. proc dialog::specialView_io-file {vv} {
  2199.     dialog::specialView_file $vv
  2200. }
  2201.  
  2202. proc dialog::specialView_file {vv} {
  2203.     if {[set sl [string length $vv]] > 33} {
  2204.     set vv "[string range $vv 0 8]...[string range $vv [expr {$sl -21}] end]"
  2205.     }
  2206.     return $vv
  2207. }
  2208. proc dialog::specialSet_file {v} {
  2209.     # Set… pressed
  2210.     set old [dialog::getFlag $v]
  2211.     if {![catch {getfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2212.       && $ff != $old} {
  2213.     dialog::modified $v $ff
  2214.     }
  2215. }
  2216. proc dialog::specialSet_io-file {v} {
  2217.     # Set… pressed
  2218.     set old [dialog::getFlag $v]
  2219.     if {![catch {putfile [quote::Prettify "New $v"] [dialog::getFlag $v]} ff] \
  2220.       && $ff != $old} {
  2221.     dialog::modified $v $ff
  2222.     }
  2223. }
  2224.  
  2225.  
  2226.  
  2227.  
  2228.  
  2229.